home *** CD-ROM | disk | FTP | other *** search
- /* Scheme In One Define.
-
- The garbage collector, the name and other parts of this program are
-
- * COPYRIGHT (c) 1989 BY *
- * PARADIGM ASSOCIATES INCORPORATED, CAMBRIDGE, MASSACHUSETTS. *
-
- Conversion to full scheme standard, characters, vectors, ports, complex &
- rational numbers, and other major enhancments by
-
- * Scaglione Ermanno, v. Pirinoli 16 IMPERIA P.M. 18100 ITALY *
-
- Permission to use, copy, modify, distribute and sell this software and its
- documentation for any purpose and without fee is hereby granted, provided
- that the above copyright notice appear in all copies and that both that
- copyright notice and this permission notice appear in supporting
- documentation, and that the name of Paradigm Associates Inc not be used in
- advertising or publicity pertaining to distribution of the software without
- specific, written prior permission.
-
- PARADIGM DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
- ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT SHALL
- PARADIGM BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
- ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER
- IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
- OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
-
- */
-
- #include <stdio.h>
- #include <string.h>
- #include <ctype.h>
- #include <setjmp.h>
- #include <signal.h>
- #include <math.h>
-
- #include "siod.h"
-
- void init_subrs(void)
- {init_subr("input-port?",tc_subr_1,input_portp);
- init_subr("output-port?",tc_subr_1,output_portp);
- init_subr("procedure?",tc_subr_1,procedurep);
- init_subr("closure?",tc_subr_1,closurep);
- init_subr("atom?",tc_subr_1,atomp);
- init_subr("eqv?",tc_subr_2,eql);
- init_subr("vector->list",tc_subr_1,vectortolist);
- init_subr("list->vector",tc_subr_1,listtovector);
- init_subr("make-vector",tc_subr_2,makevector);
- init_subr("vector-fill!",tc_subr_2,vectorfill);
- init_subr("cxr",tc_subr_2,cxr);
- init_subr("copy",tc_subr_1,copy_list);
- init_subr("list*",tc_lsubr,dotlist);
- init_subr("reverse!",tc_subr_1,reverseI);
- init_subr("append!",tc_lsubr,appendI);
- init_subr("list-ref",tc_subr_2,list_ref);
- init_subr("length",tc_subr_1,lenght);
- init_subr("pair?",tc_subr_1,consp);
- init_subr("assq",tc_subr_2,assq);
- init_subr("assoc",tc_subr_2,assoc);
- init_subr("assv",tc_subr_2,assv);
- init_subr("memq",tc_subr_2,memq);
- init_subr("memv",tc_subr_2,memv);
- init_subr("last-pair",tc_subr_1,last_pair);
- init_subr("list-tail",tc_subr_2,list_tail);
- init_subr("delq!",tc_subr_2,delq);
- init_subr("minus",tc_subr_1,minus);
- init_subr("add1",tc_subr_1,add1);
- init_subr("sub1",tc_subr_1,sub1);
- init_subr("real?",tc_subr_1,realp);
- init_subr("zero?",tc_subr_1,zerop);
- init_subr("even?",tc_subr_1,even);
- init_subr("odd?",tc_subr_1,odd);
- init_subr("negative?",tc_subr_1,negative);
- init_subr("positive?",tc_subr_1,positive);
- init_subr("string-copy",tc_subr_1,string_copy);
- init_subr("string-fill!",tc_subr_2,string_fill);
- init_subr("make-string",tc_subr_2,makestring);
- init_subr("string->symbol",tc_subr_1,string_to_symbol);
- init_subr("symbol->string",tc_subr_1,symbol_to_string);
- init_subr("string->list",tc_subr_1,string_to_list);
- init_subr("string-cmp-ci",tc_subr_2,string_cmpCI);
- init_subr("list->string",tc_subr_1,list_to_string);
- init_subr("string->number",tc_subr_3,string_to_number);
- init_subr("number->string",tc_subr_2,number_to_string);
- init_subr("integer->string",tc_subr_2,integer_to_string);
- init_subr("char-upcase",tc_subr_1,charupcase);
- init_subr("char-downcase",tc_subr_1,chardowncase);
- init_subr("string->uninterned-symbol",tc_subr_1,string_to_un_symbol);
- init_subr("gensym",tc_subr_1,gensym);
- init_subr("ascii->symbol",tc_subr_1,asctosym);
- init_subr("symbol->ascii",tc_subr_1,symtoasc);
- init_subr("begin0",tc_msubr,leval_progn0);
- init_subr("sequence",tc_msubr,leval_progn);
- init_subr("while",tc_msubr,leval_while);
- init_subr("mapc",tc_fsubr,leval_foreach);
- init_subr("mapcar",tc_fsubr,leval_map);
- init_subr("for-each",tc_fsubr,leval_foreach);
- init_subr("let*",tc_msubr,leval_let_star);
- init_subr("letrec",tc_msubr,leval_letrec);
- init_subr("named-lambda",tc_fsubr,leval_named_lambda);
- init_subr("when",tc_msubr,leval_when);
- init_subr("apply-if",tc_fsubr,leval_applyif);
- init_subr("apply",tc_fsubr,leval_apply);
- init_subr("case",tc_msubr,leval_case);
- init_subr("*catch",tc_fsubr,leval_catch);
- init_subr("*throw",tc_subr_2,lthrow);
- init_subr("not",tc_subr_1,nullp);
- init_subr("autoload-from-file",tc_fsubr,leval_aut_fr_fi);
- init_subr("file-exists?",tc_subr_1,file_exist);
- init_subr("close-input-port",tc_subr_1,close_port);
- init_subr("close-output-port",tc_subr_1,close_port);
- init_subr("set-file-position!",tc_subr_3,setfileposition);
- init_subr("get-file-position",tc_subr_1,getfileposition);
- init_subr("print-length",tc_subr_2,lprintlenght);
- init_subr("read-char",tc_subr_1,lreadchar);
- init_subr("read-line",tc_subr_1,lreadline);
- init_subr("write-char",tc_subr_2,lwritechar);
- init_subr("write",tc_subr_2,lwrite);
- init_subr("prin1",tc_subr_2,lwrite);
- init_subr("princ",tc_subr_2,lprin);
- init_subr("flush-input",tc_subr_1,lflushinput);
- init_subr("flush-port",tc_subr_1,lflush);
- init_subr("fluid",tc_fsubr,fluid);
- init_subr("set-fluid!",tc_fsubr,leval_setfluid);
- init_subr("fluid-let",tc_fsubr,leval_fluidlet);
- init_subr("fluid-lambda",tc_fsubr,leval_lambda_fluid);
- init_subr("fluid-bound?",tc_fsubr,fluid_boundp);
- init_subr("unbound?",tc_fsubr,unboundp);
- init_subr("access",tc_fsubr,laccess);
- init_subr("putprop",tc_subr_3,putprop);
- init_subr("getprop",tc_subr_2,getprop);
- init_subr("proplist",tc_subr_1,proplist);
- init_subr("remprop",tc_subr_2,remprop);
- init_subr("quasiquote",tc_msubr,leval_quasiquote);
- init_subr("procedure-environment",tc_subr_1,proc_env);
- init_subr("procedure-code",tc_subr_1,proc_code);
- init_subr("set-procedure-code!",tc_subr_2,install);
- init_subr("exit",tc_subr_0,quit);
- init_subr("bkpt",tc_fsubr,breakpoint);
- init_subr("runtime",tc_subr_0,lruntime);
- init_subr("reset",tc_subr_0,reset);
- init_subr("reset-scheme-top-level",tc_subr_0,reset_scheme_top_lev);
- init_subr("scheme-reset",tc_subr_0,scheme_reset);
- init_subr("transcript-on",tc_subr_1,transon);
- init_subr("transcript-off",tc_subr_0,transoff);
- init_subr("gc-status",tc_lsubr,gc_status);}
-